Attribute VB_Name = "Disegno2"
'FBS Macro per estrazione poligono
Function Test(step As Double) As Double()
    Dim sp As SubPath
    Dim t As Double
    Dim points(0 To 1000, 0 To 1) As Double
    Dim effectiveNumberOfPoints As Long
    effectiveNumberOfPoints = 0
 
    For Each sp In ActiveShape.Curve.SubPaths
        For t = 0 To 0.9 Step step
            Dim x As Double, y As Double
            Dim dx As Double, dy As Double
            Dim a1 As Double, a2 As Double
            sp.GetPointPositionAt x, y, t, cdrRelativeSegmentOffset
            points(effectiveNumberOfPoints, 0) = x
            points(effectiveNumberOfPoints, 1) = y
            effectiveNumberOfPoints = effectiveNumberOfPoints + 1
        Next t
    Next sp
    Dim newpoints() As Double
    ReDim newpoints(0 To effectiveNumberOfPoints - 1, 0 To 1) As Double
    For i = 0 To UBound(newpoints, 1)
        newpoints(i, 0) = points(i, 0)
        newpoints(i, 1) = points(i, 1)
    Next

    disegna newpoints
    Test = newpoints
End Function
'Avvio per la macro di FBS, skeletonizzazione e disegno
Sub MacroFBS()
    Dim points() As Double
    Dim skelSegments() As Double
    
    points = Test(0.05)
    skelSegments = skeleton(points, 0)
    disegnaSegmenti skelSegments
End Sub
